home *** CD-ROM | disk | FTP | other *** search
/ Win Platinum / Win Platinum.iso / util / audit / audit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-04-26  |  9.4 KB  |  352 lines
  1. {****  Audit 1.0 Copyright 1992 Doug Overmyer ********}
  2. program Audit;
  3. {$R audit.RES}
  4. uses WinTypes, WinProcs, WObjects, StdDlgs,Strings,StdWnds,
  5.         win31,toolhelp,sclptext;
  6. const
  7.   AU_Name =  'Heap Audit';
  8.   id_St0       = 100;
  9.   id_St1       = 101;
  10.   id_St2       = 102;
  11.   id_St3       = 103;
  12.   id_St4       = 104;
  13.   id_St5       = 105;
  14.   id_St6       = 106;
  15.   id_St7       = 107;
  16.   id_St8       = 108;
  17.   id_St9       = 109;
  18.   id_St10      = 110;
  19.   idm_AUChange = 301;
  20.   idm_AUShowHide=302;
  21.   um_ReSize    = 401;
  22.   id_About     = 501;
  23.   id_IG1  =      600;
  24.   id_CMGDI =     601;
  25.   id_CMUser =    602;
  26.   id_CMMemMgr =  603;
  27.   id_CMExit =    610;
  28. {**********************  TYPES      ******************************}
  29. type
  30.   TAUApp = object(TApplication)
  31.   procedure InitMainWindow; virtual;
  32. end;
  33.  
  34. PAUWindow = ^TAUWindow;
  35. TAUWindow = object(TWindow)
  36.     StA,StB:Array[0..10] of PSText;
  37.   StH,StJ:PSText;
  38.     SHI:TSysHeapInfo;
  39.   constructor Init(ATitle: PChar);
  40.   destructor Done; virtual;
  41.   procedure SetupWindow;virtual;
  42.   procedure IDCMGDI(Var Msg:TMessage);virtual cm_First+id_CMGDI;
  43.   procedure IDCMUser(Var Msg:TMessage);virtual cm_First+id_CMUser;
  44.   procedure IDCMMemMgr(Var Msg:TMessage);virtual cm_First+id_CMMemMgr;
  45.   procedure IDCMExit(Var Msg:TMessage);virtual cm_First+id_CMExit;
  46.   procedure SetHeader(Msg:Pchar);
  47.   procedure    WMSysCommand(var Msg:TMessage);virtual wm_First+wm_SysCommand;
  48. end;
  49. {**********************  METHODS    ******************************}
  50. procedure TAUApp.InitMainWindow;
  51. begin
  52.   MainWindow := New(PAUWindow, Init(AU_Name));
  53. end;
  54. {**********************  TAUWindow  *******************************}
  55. constructor TAUWindow.Init(ATitle: PChar);
  56. var
  57.   Indx:Integer;
  58. begin
  59.   TWindow.Init(nil, ATitle);
  60.   with Attr do
  61.     begin
  62.     X := 50; Y := 50; W := 320; H := 360;
  63.          Attr.Style := ws_Overlapped or ws_SysMenu or ws_MinimizeBox;
  64.     Menu := LoadMenu(hInstance,'AU_Menu');
  65.     end;
  66.   StH := New(PSText,Init(@Self,id_St0,'',25,30,265,20,sr_Raised,
  67.               dt_Center or dt_VCenter or dt_SingleLine));
  68.   StJ := New(PSText,Init(@Self,id_St0,'',35,5,245,20,sr_Raised,
  69.               dt_Center or dt_VCenter or dt_SingleLine));
  70.     for Indx := 1 to 10 do
  71.       begin
  72.          StA[Indx] := New(PSText,Init(@Self,101+Indx,'',15,35+25*Indx,180,20,sr_Recessed,
  73.               dt_Right or dt_VCenter or dt_SingleLine));
  74.          StB[Indx] := New(PSText,Init(@Self,101+Indx,'',215,35+25*Indx,85,20,sr_Recessed,
  75.               dt_Right or dt_VCenter or dt_SingleLine));
  76.     end;
  77. end;
  78.  
  79. destructor TAUWindow.Done;
  80. begin
  81.   TWindow.Done;
  82. end;
  83.  
  84. procedure TAUWindow.SetupWindow;
  85. var
  86.   SysMenu:HMenu;
  87.   Res :Bool;
  88.   R:record
  89.       Glob:LongInt;
  90.     PGDI:Word;
  91.     PUser:Word;
  92.     Msg:PChar;
  93.     end;
  94.   Buf:Array[0..200] of Char;
  95. begin
  96.   TWindow.SetupWindow;
  97.   SetClassWord(HWindow,GCW_HIcon,LoadIcon(HInstance,'AU_Icon'));
  98.   SetClassWord(HWindow,GCW_HBrBackground,GetStockObject(ltGray_Brush));
  99.   Sysmenu := GetSystemMenu(hWindow,false);
  100.   AppendMenu(SysMenu,MF_Separator,0,nil);
  101.   AppendMenu(Sysmenu,0,id_About,'About...');
  102.   SetHeader('');
  103.     end;
  104.  
  105. procedure TAUWindow.SetHeader(Msg:PChar);
  106. var
  107.   Res :Bool;
  108.   R:record
  109.       Glob:LongInt;
  110.     PGDI:Word;
  111.     PUser:Word;
  112.     Msg:PChar;
  113.     end;
  114.   Buf:Array[0..200] of Char;
  115. begin
  116.   Shi.dwSize := Sizeof(SHI);
  117.   Res := SystemHeapInfo(@SHI);
  118.   R.Glob := GetFreeSpace(0);
  119.   R.PGDI := SHI.wGDIFreePercent;
  120.   R.PUser := SHI.wUserFreePercent;
  121.   wvsprintf(Buf,'GMem:%lu  %%GDI:%u  %%User:%u',R);
  122.   StH^.SetText(Buf);
  123.   StJ^.SetText(Msg);
  124. end;
  125.  
  126. procedure TAUWindow.IDCMGDI(var Msg:TMessage);
  127. var
  128.   Res:Bool;
  129.   LI:TLocalInfo;
  130.   LE:TLocalEntry;
  131.   Indx:Integer;
  132.   Buf:Array[0..50] of Char;
  133.   H:record
  134.       cBitmap,cBrush,cDC,CFont,cMetaFile,cMetaDC,cPalette,
  135.       cPen,cRgn:Integer;
  136.   end;
  137. begin
  138.     H.cBitmap := 0;H.cBrush := 0;H.cDC := 0;H.cFont := 0;
  139.   H.cMetaFile := 0;H.cMetaDC := 0;H.cPalette := 0;H.cPen := 0;H.cRgn := 0;
  140.   LI.dwSize := sizeof(LI);
  141.   Res := LocalInfo(@LI,SHI.hGDISegment);
  142.   LE.dwSize := sizeof(LE);
  143.   for Indx := 0 to Pred(LI.wcItems) do
  144.       begin
  145.     if Indx = 0 then
  146.         res := LocalFirst(@LE,SHI.hGDISegment)
  147.     else
  148.         res := LocalNext(@LE);
  149.       case LE.wType of
  150.         LT_GDI_BITMAP:Inc(H.cBitmap);
  151.       LT_GDI_BRUSH:Inc(H.cBrush);
  152.       LT_GDI_DC:Inc(H.cDC);
  153.       LT_GDI_FONT:Inc(H.cFont);
  154.       LT_GDI_METADC:Inc(H.cMetaDC);
  155.       LT_GDI_METAFILE:Inc(H.cMetaFile);
  156.       LT_GDI_PALETTE:Inc(H.cPalette);
  157.       LT_GDI_PEN:Inc(H.cPen);
  158.       LT_GDI_RGN:Inc(H.cRgn);
  159.     end;
  160.       end;
  161.     for Indx := 1 to 10 do
  162.       begin
  163.     StA[Indx]^.SetText('');
  164.     STB[Indx]^.SetText('');
  165.     end;
  166.   StA[1]^.SetText('# Bitmaps:');
  167.   StA[2]^.SetText('# Brushes');
  168.   StA[3]^.SetText('# Device Contexts:');;
  169.   StA[4]^.SetText('# Fonts:');
  170.   StA[5]^.SetText('# Metafiles:');
  171.   StA[6]^.SetText('# MetaDCs:');
  172.   StA[7]^.SetText('# Palettes:');
  173.   StA[8]^.SetText('# Pens:');
  174.   StA[9]^.SetText('# Regions:');
  175.   StA[10]^.SetText('');
  176.     SetHeader('GDI Local Heap Info');
  177.  
  178.   wvsprintf(Buf,'%i',H.cBitmap);
  179.   StB[1]^.SetText(buf);
  180.   wvsprintf(Buf,'%i',H.cBrush);
  181.   StB[2]^.SetText(buf);
  182.   wvsprintf(Buf,'%i',H.cDC);
  183.   StB[3]^.SetText(buf);
  184.   wvsprintf(Buf,'%i',H.cFont);
  185.   StB[4]^.SetText(buf);
  186.   wvsprintf(Buf,'%i',H.cMetaFile);
  187.   StB[5]^.SetText(buf);
  188.   wvsprintf(Buf,'%i',H.cMetaDC);
  189.   StB[6]^.SetText(buf);
  190.   wvsprintf(Buf,'%i',H.cPalette);
  191.   StB[7]^.SetText(buf);
  192.   wvsprintf(Buf,'%i',H.cPen);
  193.   StB[8]^.SetText(buf);
  194.   wvsprintf(Buf,'%i',H.cRgn);
  195.   StB[9]^.SetText(buf);
  196.   StB[10]^.SetText('');
  197. end;
  198.  
  199. procedure TAUWindow.IDCMUser(var Msg:TMessage);
  200. var
  201.   Res:Bool;
  202.   LI:TLocalInfo;
  203.   LE:TLocalEntry;
  204.   Indx:Integer;
  205.   Buf:Array[0..50] of Char;
  206.   H:record
  207.       cAtoms,cCBox,cClass,CEd,cLBIV,cMenu,cProp,
  208.       cWnd:Integer;
  209.   end;
  210. begin
  211.     H.cAtoms := 0;H.cCBox := 0;H.cClass := 0;H.cEd := 0;
  212.   H.cLBIV := 0;H.cMenu := 0;H.cProp := 0;H.cWnd := 0; 
  213.   LI.dwSize := sizeof(LI);
  214.   Res := LocalInfo(@LI,SHI.hUserSegment);
  215.   LE.dwSize := sizeof(LE);
  216.   for Indx := 0 to Pred(LI.wcItems) do
  217.       begin
  218.     if Indx = 0 then
  219.         res := LocalFirst(@LE,SHI.hUserSegment)
  220.     else
  221.         res := LocalNext(@LE);
  222.       case LE.wType of
  223.         LT_USER_ATOMS:Inc(H.cAtoms);
  224.       LT_USER_CBOX:Inc(H.cCBox);
  225.       LT_USER_CLASS:Inc(H.cClass);
  226.       LT_USER_ED:Inc(H.cED);
  227.       LT_USER_LBIV:Inc(H.cLBIV );
  228.       LT_USER_MENU:Inc(H.cMenu);
  229.       LT_USER_PROP:Inc(H.cProp);
  230.       LT_USER_WND:Inc(H.cWnd);
  231.     end;
  232.       end;
  233.     for Indx := 1 to 10 do
  234.       begin
  235.     StA[Indx]^.SetText('');
  236.     STB[Indx]^.SetText('');
  237.     end;
  238.   StA[1]^.SetText('# Atoms');
  239.   wvsprintf(Buf,'%i',H.cAtoms);
  240.   StB[1]^.SetText(buf);
  241.  
  242.   STA[2]^.SetText('# Combo Boxes');
  243.   wvsprintf(Buf,'%i',H.cCBox);
  244.   StB[2]^.SetText(buf);
  245.  
  246.   StA[3]^.SetText('# Class Structures');
  247.   wvsprintf(Buf,'%i',H.cClass);
  248.   StB[3]^.SetText(buf);
  249.  
  250.   STA[4]^.SetText('# Edit Controls');
  251.   wvsprintf(Buf,'%i',H.cEd );
  252.   StB[4]^.SetText(buf);
  253.  
  254.   StA[5]^.SetText('# Listbox Controls');
  255.   wvsprintf(Buf,'%i',H.cLBIV);
  256.   StB[5]^.SetText(buf);
  257.  
  258.   STA[6]^.SetText('# Menus');
  259.   wvsprintf(Buf,'%i',H.cMenu);
  260.   StB[6]^.SetText(buf);
  261.  
  262.   STA[7]^.SetText('# Property Structures');
  263.   wvsprintf(Buf,'%i',H.cProp);
  264.   StB[7]^.SetText(buf);
  265.  
  266.   STA[8]^.SetText('# Window Structures');
  267.   wvsprintf(Buf,'%i',H.cWnd);
  268.   StB[8]^.SetText(buf);
  269.  
  270.   SetHeader('User Local Heap Info (Debug only)');
  271. end;
  272.  
  273. procedure TAUWindow.IDCMMemMgr(var Msg:TMessage);
  274. var
  275.     MMI:TMemManInfo;
  276.   Buf:Array[0..50] of Char;
  277.   dwFlag:LongInt;
  278.   Indx :Integer;
  279. begin
  280.     for Indx := 1 to 10 do
  281.       begin
  282.     StA[Indx]^.SetText('');
  283.     STB[Indx]^.SetText('');
  284.     end;
  285.     dwFlag := GetWinFlags;
  286.   if dwFlag and WF_ENHANCED  =  0 then
  287.       begin
  288.       SetHeader('Valid info in 386 Enhanced only!');
  289.       Exit;
  290.     end;
  291.     MMI.dwSize := sizeOf(MMI);
  292.   MemManInfo(@MMI);
  293.   MMI.dwFreeLinearSpace := MMI.dwFreeLinearSpace * MMI.wPageSize;
  294.   MMI.dwTotalLinearSpace := MMI.dwTotalLinearSpace * MMI.wPageSize;
  295.  
  296.   StA[1]^.SetText('Largest Free Block');
  297.   wvsprintf(Buf,'%lu',MMI.dwLargestFreeBlock);
  298.   StB[1]^.SetText(buf);
  299.   StA[2]^.SetText('Max Pages Available');
  300.   wvsprintf(Buf,'%lu',MMI.dwMaxPagesAvailable);
  301.   StB[2]^.SetText(buf);
  302.   StA[3]^.SetText('Max Pages Lockable');
  303.   wvsprintf(Buf,'%lu',MMI.dwMaxPagesLockable);
  304.   StB[3]^.SetText(buf);
  305.   StA[4]^.SetText('Total Linear Space');
  306.   wvsprintf(Buf,'%lu',MMI.dwTotalLinearSpace );
  307.   StB[4]^.SetText(buf);
  308.   StA[5]^.SetText('Total Unlocked Pages');
  309.   wvsprintf(Buf,'%lu',MMI.dwTotalUnlockedPages);
  310.   StB[5]^.SetText(buf);
  311.   StA[6]^.SetText('Free Pages');
  312.   wvsprintf(Buf,'%lu',MMI.dwFreePages);
  313.   StB[6]^.SetText(buf);
  314.   StA[7]^.SetText('Total Pages');
  315.   wvsprintf(Buf,'%lu',MMI.dwTotalPages);
  316.   StB[7]^.SetText(buf);
  317.   StA[8]^.SetText('Free Linear Space');
  318.   wvsprintf(Buf,'%lu',MMI.dwFreeLinearSpace);
  319.   StB[8]^.SetText(buf);
  320.   StA[9]^.SetText('Swap File Pages');
  321.   wvsprintf(Buf,'%lu',MMI.dwSwapFilePages);
  322.   StB[9]^.SetText(buf);
  323.   StA[10]^.SetText('Page Size');
  324.   wvsprintf(Buf,'%u',MMI.wPageSize);
  325.   StB[10]^.SetText(buf);
  326.     SetHeader('Memory Manager Info');
  327. end;
  328.  
  329. procedure TAUWindow.IDCMExit(var Msg:TMessage);
  330. begin
  331.     CloseWindow;
  332. end;
  333.  
  334. procedure    TAUWindow.WMSysCommand(var Msg:TMessage);
  335. begin
  336.     case Msg.Wparam of
  337.         id_About:
  338.              application^.ExecDialog(New(PDialog,Init(@Self,'AU_About')));
  339.        else
  340.            DefWndProc(Msg);
  341.        end;
  342. end;
  343.  
  344. {**********************  MainLine   *******************************}
  345. var
  346.   AUApp: TAUApp;
  347. begin
  348.   AUApp.Init(AU_Name);
  349.   AUApp.Run;
  350.   AUApp.Done;
  351. end.
  352.